home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / src / tclCkalloc.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-25  |  17.5 KB  |  619 lines  |  [TEXT/MPS ]
  1. #ifdef MPW
  2. #    pragma segment TCL_MAIN
  3. #endif
  4.  
  5. /* 
  6.  * tclCkalloc.c --
  7.  *    Interface to malloc and free that provides support for debugging problems
  8.  *    involving overwritten, double freeing memory and loss of memory.
  9.  *
  10.  * Copyright (c) 1991-1993 The Regents of the University of California.
  11.  * All rights reserved.
  12.  *
  13.  * Permission is hereby granted, without written agreement and without
  14.  * license or royalty fees, to use, copy, modify, and distribute this
  15.  * software and its documentation for any purpose, provided that the
  16.  * above copyright notice and the following two paragraphs appear in
  17.  * all copies of this software.
  18.  * 
  19.  * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  20.  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  21.  * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  22.  * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  23.  *
  24.  * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  25.  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  26.  * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  27.  * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  28.  * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  29.  *
  30.  * This code contributed by Karl Lehenbauer and Mark Diekhans
  31.  *
  32.  */
  33.  
  34. #include "tclInt.h"
  35.  
  36. #define FALSE    0
  37. #define TRUE    1
  38.  
  39. #ifdef TCL_MEM_DEBUG
  40. #ifndef TCL_GENERIC_ONLY
  41. #include "tclUnix.h"
  42. #endif
  43.  
  44. #define GUARD_SIZE 8
  45.  
  46. struct mem_header {
  47.         long               length;
  48.         char              *file;
  49.         int                line;
  50.         struct mem_header *flink;
  51.         struct mem_header *blink;
  52.     int           dummy;    /* Aligns body on 8-byte boundary. */
  53.         unsigned char      low_guard[GUARD_SIZE];
  54.         char               body[1];
  55. };
  56.  
  57. static struct mem_header *allocHead = NULL;  /* List of allocated structures */
  58.  
  59. #define GUARD_VALUE  0341
  60.  
  61. /* static char high_guard[] = {0x89, 0xab, 0xcd, 0xef}; */
  62.  
  63. static int total_mallocs = 0;
  64. static int total_frees = 0;
  65. static int current_bytes_malloced = 0;
  66. static int maximum_bytes_malloced = 0;
  67. static int current_malloc_packets = 0;
  68. static int maximum_malloc_packets = 0;
  69. static int break_on_malloc = 0;
  70. static int trace_on_at_malloc = 0;
  71. static int  alloc_tracing = FALSE;
  72. static int  init_malloced_bodies = TRUE;
  73. #ifdef MEM_VALIDATE
  74.     static int  validate_memory = TRUE;
  75. #else
  76.     static int  validate_memory = FALSE;
  77. #endif
  78.  
  79. /*
  80.  * Prototypes for procedures defined in this file:
  81.  */
  82.  
  83. static int        MemoryCmd _ANSI_ARGS_((ClientData clientData,
  84.                 Tcl_Interp *interp, int argc, char **argv));
  85.  
  86.  
  87. #ifdef macintosh
  88. #    define fprintf        mac_fprintf
  89. #endif
  90.  
  91.  
  92.  
  93. /*
  94.  *----------------------------------------------------------------------
  95.  *
  96.  * dump_memory_info --
  97.  *     Display the global memory management statistics.
  98.  *
  99.  *----------------------------------------------------------------------
  100.  */
  101. static void
  102. dump_memory_info(outFile) 
  103.     FILE *outFile;
  104. {
  105.         fprintf(outFile,"total mallocs             %10d\n", 
  106.                 total_mallocs);
  107.         fprintf(outFile,"total frees               %10d\n", 
  108.                 total_frees);
  109.         fprintf(outFile,"current packets allocated %10d\n", 
  110.                 current_malloc_packets);
  111.         fprintf(outFile,"current bytes allocated   %10d\n", 
  112.                 current_bytes_malloced);
  113.         fprintf(outFile,"maximum packets allocated %10d\n", 
  114.                 maximum_malloc_packets);
  115.         fprintf(outFile,"maximum bytes allocated   %10d\n", 
  116.                 maximum_bytes_malloced);
  117. }
  118.  
  119. /*
  120.  *----------------------------------------------------------------------
  121.  *
  122.  * ValidateMemory --
  123.  *     Procedure to validate allocted memory guard zones.
  124.  *
  125.  *----------------------------------------------------------------------
  126.  */
  127. static void
  128. ValidateMemory (memHeaderP, file, line, nukeGuards)
  129.     struct mem_header *memHeaderP;
  130.     char              *file;
  131.     int                line;
  132.     int                nukeGuards;
  133. {
  134.     unsigned char *hiPtr;
  135.     int   idx;
  136.     int   guard_failed = FALSE;
  137.     int byte;
  138.     
  139.     for (idx = 0; idx < GUARD_SIZE; idx++) {
  140.         byte = *(memHeaderP->low_guard + idx);
  141.         if (byte != GUARD_VALUE) {
  142.             guard_failed = TRUE;
  143.             fflush (stdout);
  144.         byte &= 0xff;
  145.             fprintf(stderr, "low guard byte %d is 0x%x  \t%c\n", idx, byte,
  146.             (isprint(UCHAR(byte)) ? byte : ' '));
  147.         }
  148.     }
  149.     if (guard_failed) {
  150.         dump_memory_info (stderr);
  151.         fprintf (stderr, "low guard failed at %lx, %s %d\n",
  152.                  memHeaderP->body, file, line);
  153.         fflush (stderr);  /* In case name pointer is bad. */
  154.         fprintf (stderr, "%d bytes allocated at (%s %d)\n", memHeaderP->length,
  155.         memHeaderP->file, memHeaderP->line);
  156.         panic ("Memory validation failure");
  157.     }
  158.  
  159.     hiPtr = (unsigned char *)memHeaderP->body + memHeaderP->length;
  160.     for (idx = 0; idx < GUARD_SIZE; idx++) {
  161.         byte = *(hiPtr + idx);
  162.         if (byte != GUARD_VALUE) {
  163.             guard_failed = TRUE;
  164.             fflush (stdout);
  165.         byte &= 0xff;
  166.             fprintf(stderr, "hi guard byte %d is 0x%x  \t%c\n", idx, byte,
  167.             (isprint(UCHAR(byte)) ? byte : ' '));
  168.         }
  169.     }
  170.  
  171.     if (guard_failed) {
  172.         dump_memory_info (stderr);
  173.         fprintf (stderr, "high guard failed at %lx, %s %d\n",
  174.                  memHeaderP->body, file, line);
  175.         fflush (stderr);  /* In case name pointer is bad. */
  176.         fprintf (stderr, "%d bytes allocated at (%s %d)\n", memHeaderP->length,
  177.         memHeaderP->file, memHeaderP->line);
  178.         panic ("Memory validation failure");
  179.     }
  180.  
  181.     if (nukeGuards) {
  182.         memset ((char *) memHeaderP->low_guard, 0, GUARD_SIZE); 
  183.         memset ((char *) hiPtr, 0, GUARD_SIZE); 
  184.     }
  185.  
  186. }
  187.  
  188. /*
  189.  *----------------------------------------------------------------------
  190.  *
  191.  * Tcl_ValidateAllMemory --
  192.  *     Validates guard regions for all allocated memory.
  193.  *
  194.  *----------------------------------------------------------------------
  195.  */
  196. void
  197. Tcl_ValidateAllMemory (file, line)
  198.     char  *file;
  199.     int    line;
  200. {
  201.     struct mem_header *memScanP;
  202.  
  203.     for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink)
  204.         ValidateMemory (memScanP, file, line, FALSE);
  205.  
  206. }
  207.  
  208. /*
  209.  *----------------------------------------------------------------------
  210.  *
  211.  * Tcl_DumpActiveMemory --
  212.  *     Displays all allocated memory to stderr.
  213.  *
  214.  * Results:
  215.  *     Return TCL_ERROR if an error accessing the file occures, `errno' 
  216.  *     will have the file error number left in it.
  217.  *----------------------------------------------------------------------
  218.  */
  219. int
  220. Tcl_DumpActiveMemory (fileName)
  221.     char *fileName;
  222. {
  223.     FILE              *fileP;
  224.     struct mem_header *memScanP;
  225.     char              *address;
  226.  
  227.     fileP = fopen (fileName, "w");
  228.     if (fileP == NULL)
  229.         return TCL_ERROR;
  230.  
  231.     for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
  232.         address = &memScanP->body [0];
  233.         fprintf (fileP, "%8lx - %8lx  %7d @ %s %d", address,
  234.                  address + memScanP->length - 1, memScanP->length,
  235.                  memScanP->file, memScanP->line);
  236.     (void) fputc('\n', fileP);
  237.     }
  238.     fclose (fileP);
  239.     return TCL_OK;
  240. }
  241.  
  242. /*
  243.  *----------------------------------------------------------------------
  244.  *
  245.  * Tcl_DbCkalloc - debugging ckalloc
  246.  *
  247.  *        Allocate the requested amount of space plus some extra for
  248.  *        guard bands at both ends of the request, plus a size, panicing 
  249.  *        if there isn't enough space, then write in the guard bands
  250.  *        and return the address of the space in the middle that the
  251.  *        user asked for.
  252.  *
  253.  *        The second and third arguments are file and line, these contain
  254.  *        the filename and line number corresponding to the caller.
  255.  *        These are sent by the ckalloc macro; it uses the preprocessor
  256.  *        autodefines __FILE__ and __LINE__.
  257.  *
  258.  *----------------------------------------------------------------------
  259.  */
  260. char *
  261. Tcl_DbCkalloc(size, file, line)
  262.     unsigned int size;
  263.     char        *file;
  264.     int          line;
  265. {
  266.     struct mem_header *result;
  267.  
  268.     if (validate_memory)
  269.         Tcl_ValidateAllMemory (file, line);
  270.  
  271.     result = (struct mem_header *)malloc((unsigned)size + 
  272.                               sizeof(struct mem_header) + GUARD_SIZE);
  273.     if (result == NULL) {
  274.         fflush(stdout);
  275.         dump_memory_info(stderr);
  276.         panic("unable to alloc %d bytes, %s line %d", size, file, 
  277.               line);
  278.     }
  279.  
  280.     /*
  281.      * Fill in guard zones and size.  Also initialize the contents of
  282.      * the block with bogus bytes to detect uses of initialized data.
  283.      * Link into allocated list.
  284.      */
  285.     if (init_malloced_bodies) {
  286.         memset ((VOID *) result, GUARD_VALUE,
  287.         size + sizeof(struct mem_header) + GUARD_SIZE);
  288.     } else {
  289.     memset ((char *) result->low_guard, GUARD_VALUE, GUARD_SIZE);
  290.     memset (result->body + size, GUARD_VALUE, GUARD_SIZE);
  291.     }
  292.     result->length = size;
  293.     result->file = file;
  294.     result->line = line;
  295.     result->flink = allocHead;
  296.     result->blink = NULL;
  297.     if (allocHead != NULL)
  298.         allocHead->blink = result;
  299.     allocHead = result;
  300.  
  301.     total_mallocs++;
  302.     if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) {
  303.         (void) fflush(stdout);
  304.         fprintf(stderr, "reached malloc trace enable point (%d)\n",
  305.                 total_mallocs);
  306.         fflush(stderr);
  307.         alloc_tracing = TRUE;
  308.         trace_on_at_malloc = 0;
  309.     }
  310.  
  311.     if (alloc_tracing)
  312.         fprintf(stderr,"ckalloc %lx %d %s %d\n", result->body, size, 
  313.                 file, line);
  314.  
  315.     if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
  316.         break_on_malloc = 0;
  317.         (void) fflush(stdout);
  318.         fprintf(stderr,"reached malloc break limit (%d)\n", 
  319.                 total_mallocs);
  320.         fprintf(stderr, "program will now enter C debugger\n");
  321.         (void) fflush(stderr);
  322.     abort();
  323.     }
  324.  
  325.     current_malloc_packets++;
  326.     if (current_malloc_packets > maximum_malloc_packets)
  327.         maximum_malloc_packets = current_malloc_packets;
  328.     current_bytes_malloced += size;
  329.     if (current_bytes_malloced > maximum_bytes_malloced)
  330.         maximum_bytes_malloced = current_bytes_malloced;
  331.  
  332.     return result->body;
  333. }
  334.  
  335. /*
  336.  *----------------------------------------------------------------------
  337.  *
  338.  * Tcl_DbCkfree - debugging ckfree
  339.  *
  340.  *        Verify that the low and high guards are intact, and if so
  341.  *        then free the buffer else panic.
  342.  *
  343.  *        The guards are erased after being checked to catch duplicate
  344.  *        frees.
  345.  *
  346.  *        The second and third arguments are file and line, these contain
  347.  *        the filename and line number corresponding to the caller.
  348.  *        These are sent by the ckfree macro; it uses the preprocessor
  349.  *        autodefines __FILE__ and __LINE__.
  350.  *
  351.  *----------------------------------------------------------------------
  352.  */
  353.  
  354. int
  355. Tcl_DbCkfree(ptr, file, line)
  356.     char *  ptr;
  357.     char     *file;
  358.     int       line;
  359. {
  360.     struct mem_header *memp = 0;  /* Must be zero for size calc */
  361.  
  362.     /*
  363.      * Since header ptr is zero, body offset will be size
  364.      */
  365. #ifdef _CRAYCOM
  366.     memp = (struct mem_header *)((char *) ptr  - (sizeof(int)*((unsigned)&(memp->body))));
  367. #else
  368.     memp = (struct mem_header *)(((char *) ptr) - (int)memp->body);
  369. #endif
  370.  
  371.     if (alloc_tracing)
  372.         fprintf(stderr, "ckfree %lx %ld %s %d\n", memp->body, 
  373.                 memp->length, file, line);
  374.  
  375.     if (validate_memory)
  376.         Tcl_ValidateAllMemory (file, line);
  377.  
  378.     ValidateMemory (memp, file, line, TRUE);
  379.     if (init_malloced_bodies) {
  380.     memset((VOID *) ptr, GUARD_VALUE, memp->length);
  381.     }
  382.  
  383.     total_frees++;
  384.     current_malloc_packets--;
  385.     current_bytes_malloced -= memp->length;
  386.  
  387.     /*
  388.      * Delink from allocated list
  389.      */
  390.     if (memp->flink != NULL)
  391.         memp->flink->blink = memp->blink;
  392.     if (memp->blink != NULL)
  393.         memp->blink->flink = memp->flink;
  394.     if (allocHead == memp)
  395.         allocHead = memp->flink;
  396.     free((char *) memp);
  397.     return 0;
  398. }
  399.  
  400. /*
  401.  *--------------------------------------------------------------------
  402.  *
  403.  * Tcl_DbCkrealloc - debugging ckrealloc
  404.  *
  405.  *    Reallocate a chunk of memory by allocating a new one of the
  406.  *    right size, copying the old data to the new location, and then
  407.  *    freeing the old memory space, using all the memory checking
  408.  *    features of this package.
  409.  *
  410.  *--------------------------------------------------------------------
  411.  */
  412. char *
  413. Tcl_DbCkrealloc(ptr, size, file, line)
  414.     char *ptr;
  415.     unsigned int size;
  416.     char *file;
  417.     int line;
  418. {
  419.     char *new;
  420.     unsigned int copySize;
  421.     struct mem_header *memp = 0;  /* Must be zero for size calc */
  422.  
  423. #ifdef _CRAYCOM
  424.     memp = (struct mem_header *)((char *) ptr  - (sizeof(int)*((unsigned)&(memp->body))));
  425. #else
  426.     memp = (struct mem_header *)(((char *) ptr) - (int)memp->body);
  427. #endif
  428.     copySize = size;
  429.     if (copySize > memp->length) {
  430.     copySize = memp->length;
  431.     }
  432.     new = Tcl_DbCkalloc(size, file, line);
  433.     memcpy((VOID *) new, (VOID *) ptr, (int) copySize);
  434.     Tcl_DbCkfree(ptr, file, line);
  435.     return(new);
  436. }
  437.  
  438. /*
  439.  *----------------------------------------------------------------------
  440.  *
  441.  * MemoryCmd --
  442.  *     Implements the TCL memory command:
  443.  *       memory info
  444.  *       memory display
  445.  *       break_on_malloc count
  446.  *       trace_on_at_malloc count
  447.  *       trace on|off
  448.  *       validate on|off
  449.  *
  450.  * Results:
  451.  *     Standard TCL results.
  452.  *
  453.  *----------------------------------------------------------------------
  454.  */
  455.     /* ARGSUSED */
  456. static int
  457. MemoryCmd (clientData, interp, argc, argv)
  458.     ClientData  clientData;
  459.     Tcl_Interp *interp;
  460.     int         argc;
  461.     char      **argv;
  462. {
  463.     char *fileName;
  464.     Tcl_DString buffer;
  465.     int result;
  466.  
  467.     if (argc < 2) {
  468.     Tcl_AppendResult(interp, "wrong # args:  should be \"",
  469.         argv[0], " option [args..]\"", (char *) NULL);
  470.     return TCL_ERROR;
  471.     }
  472.  
  473.     if (strcmp(argv[1],"trace") == 0) {
  474.         if (argc != 3) 
  475.             goto bad_suboption;
  476.         alloc_tracing = (strcmp(argv[2],"on") == 0);
  477.         return TCL_OK;
  478.     }
  479.     if (strcmp(argv[1],"init") == 0) {
  480.         if (argc != 3)
  481.             goto bad_suboption;
  482.         init_malloced_bodies = (strcmp(argv[2],"on") == 0);
  483.         return TCL_OK;
  484.     }
  485.     if (strcmp(argv[1],"validate") == 0) {
  486.         if (argc != 3)
  487.              goto bad_suboption;
  488.         validate_memory = (strcmp(argv[2],"on") == 0);
  489.         return TCL_OK;
  490.     }
  491.     if (strcmp(argv[1],"trace_on_at_malloc") == 0) {
  492.         if (argc != 3) 
  493.             goto argError;
  494.         if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK)
  495.                 return TCL_ERROR;
  496.          return TCL_OK;
  497.     }
  498.     if (strcmp(argv[1],"break_on_malloc") == 0) {
  499.         if (argc != 3) 
  500.             goto argError;
  501.         if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK)
  502.                 return TCL_ERROR;
  503.         return TCL_OK;
  504.     }
  505.  
  506.     if (strcmp(argv[1],"info") == 0) {
  507.         dump_memory_info(stdout);
  508.         return TCL_OK;
  509.     }
  510.     if (strcmp(argv[1],"active") == 0) {
  511.         if (argc != 3) {
  512.         Tcl_AppendResult(interp, "wrong # args:  should be \"",
  513.             argv[0], " active file", (char *) NULL);
  514.         return TCL_ERROR;
  515.     }
  516.     fileName = Tcl_TildeSubst(interp, argv[2], &buffer);
  517.     if (fileName == NULL) {
  518.         return TCL_ERROR;
  519.     }
  520.     result = Tcl_DumpActiveMemory (fileName);
  521.     Tcl_DStringFree(&buffer);
  522.     if (result != TCL_OK) {
  523.         Tcl_AppendResult(interp, "error accessing ", argv[2], 
  524.             (char *) NULL);
  525.         return TCL_ERROR;
  526.     }
  527.     return TCL_OK;
  528.     }
  529.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  530.         "\":  should be info, init, active, break_on_malloc, ",
  531.         "trace_on_at_malloc, trace, or validate", (char *) NULL);
  532.     return TCL_ERROR;
  533.  
  534. argError:
  535.     Tcl_AppendResult(interp, "wrong # args:  should be \"", argv[0],
  536.         " ", argv[1], "count\"", (char *) NULL);
  537.     return TCL_ERROR;
  538.  
  539. bad_suboption:
  540.     Tcl_AppendResult(interp, "wrong # args:  should be \"", argv[0],
  541.         " ", argv[1], " on|off\"", (char *) NULL);
  542.     return TCL_ERROR;
  543. }
  544.  
  545. /*
  546.  *----------------------------------------------------------------------
  547.  *
  548.  * Tcl_InitMemory --
  549.  *     Initialize the memory command.
  550.  *
  551.  *----------------------------------------------------------------------
  552.  */
  553. void
  554. Tcl_InitMemory(interp)
  555.     Tcl_Interp *interp;
  556. {
  557. Tcl_CreateCommand (interp, "memory", MemoryCmd, (ClientData) NULL, 
  558.                   (Tcl_CmdDeleteProc *) NULL);
  559. }
  560.  
  561. #else
  562.  
  563.  
  564. /*
  565.  *----------------------------------------------------------------------
  566.  *
  567.  * Tcl_Ckalloc --
  568.  *     Interface to malloc when TCL_MEM_DEBUG is disabled.  It does check
  569.  *     that memory was actually allocated.
  570.  *
  571.  *----------------------------------------------------------------------
  572.  */
  573. VOID *
  574. Tcl_Ckalloc (size)
  575.     unsigned int size;
  576. {
  577.         char *result;
  578.  
  579.         result = malloc(size);
  580.         if (result == NULL) 
  581.                 panic("unable to alloc %d bytes", size);
  582.         return result;
  583. }
  584.  
  585. /*
  586.  *----------------------------------------------------------------------
  587.  *
  588.  * TckCkfree --
  589.  *     Interface to free when TCL_MEM_DEBUG is disabled.  Done here rather
  590.  *     in the macro to keep some modules from being compiled with 
  591.  *     TCL_MEM_DEBUG enabled and some with it disabled.
  592.  *
  593.  *----------------------------------------------------------------------
  594.  */
  595. void
  596. Tcl_Ckfree (ptr)
  597.     VOID *ptr;
  598. {
  599.         free (ptr);
  600. }
  601.  
  602. /*
  603.  *----------------------------------------------------------------------
  604.  *
  605.  * Tcl_InitMemory --
  606.  *     Dummy initialization for memory command, which is only available 
  607.  *     if TCL_MEM_DEBUG is on.
  608.  *
  609.  *----------------------------------------------------------------------
  610.  */
  611.     /* ARGSUSED */
  612. void
  613. Tcl_InitMemory(interp)
  614.     Tcl_Interp *interp;
  615. {
  616. }
  617.  
  618. #endif
  619.